COMMENT ⊗   VALID 00009 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	TITLE Display routines to do i/o from Pascal
C00003 00003	Misc routines: BEEP, INITSC, REINIT, RESETS, CLEARS & ECHO, ESCINI & ESCINT
C00008 00004	Cursor postioning routine: SHOWCU
C00012 00005	Aux routines to set up position commands: DMPOS & DDPOS
C00014 00006	Line output routine: OUTLIN
C00020 00007	Character routines: GETCHAR, ANYCHAR & OUTCHAR
C00022 00008	Special DM routines: INSCHA, DELCHA, INSLIN & DELLIN
C00025 00009	Line editor routines: LINEDP & LOADED
C00028 ENDMK
C⊗;
TITLE Display routines to do i/o from Pascal

P ← 17
DMFLAG ←  32000
DDFLAG ←  200000
DMQUOT ←  100000
USERGO ←  2000

DD ← 20000	;RUNNING ON DATA DISK (BITS FROM GETLIN)
DM ← 40000	;  "     "  DATAMEDIA

DEFINE CW(C1,D1,C2,D2,C3,D3)<BYTE(8)D1,D2,D3(3)C1,C2,C3,4>

	TWOSEG 400000		;Initialize for two-segments
	RELOC 0
	RELOC 400000

INTERNAL BEEP,INITSC,REINIT,RESETS,CLEARS,ECHO,SHOWCU,OUTLIN,LINEDP,LOADED
INTERNAL GETCHA,ANYCHA,OUTCHA,INSCHA,DELCHA,INSLIN,DELLIN,ESCINI

;Misc routines: BEEP, INITSC, REINIT, RESETS, CLEARS & ECHO, ESCINI & ESCINT

BEEP:	HRROI 1,-1
	BEEP 1,
	POPJ P,

INITSC:	MOVEM 2,TBASE		;Remember base address of listing array
	SETO 1,
	GETLIN 1		;get our terminals characteristics
	SETZ 2,			;Assume DM
	TLNE 1,DD		;Check if Data Disk
	JRST IDD		; yup - deal with it below
	MOVE 1,[XWD DMFLAG,LPOS]
	MOVEM 1,LBCMD		;Set things up for OUTLIN
	MOVEI 4,=22		;DM's have 24 lines, but leave 2 for the wholine
	JRST I1
IDD:	AOJ 2,			; Is DD
	MOVE 1,[XWD DDFLAG,LBCMD1]
	MOVEM 1,LBCMD		;Set things up for OUTLIN
	MOVEI 4,=38		;DD's have 40 lines, but leave 2 for the wholine
I1:	MOVEM 2,TERM		;Store away for later
	MOVEM 4,1(P)		;Return screen height
	POPJ P,

	RELOC		;use low seg
TBASE:	0
TERM:	0		;0 = DM, 1 = DD
	RELOC		;back to high seg

REINIT:	PUSHJ P,CLEARS		;Clear the screen
	DPYSIZ 3002		; = 3 glitches/ 2 lines each (not really used)
	DPYPOS -1777		;Move page printer off page
	SETACT [0,,ACTTAB]	;Activate on ANY character (bye-bye line editor)
	MOVE 1,[-1,,ACTON]	;Turn on special activation mode
	TTYSET 1,
	POPJ P,

RESETS:	SETACT [0,,ACTOLD]	;Restore world for line editor
	MOVE 1,[-2,,ACTOFF]	;Turn off special activation mode & do a break N
	TTYSET 1,
	POPJ P,

ACTOFF:	XWD 002000,100		;Turn off special activation mode
	XWD 004000,516		;Clear & Normalize screen via Break N
ACTON:	XWD 001000,100		;Turn on special activation mode
ACTTAB:	XWD 777777,777777	;Special activation table
	XWD 777777,777777	; activate on ALL characters
	XWD 777777,777777
	XWD 777777,640066	;also set SUPCT,ALLACT,BSACT,SUPSCM & SUPCCR
ACTOLD:	OCT 0,0,0,0		;so we can turn off the above bits

CLEARS:	MOVE 7,TERM
	DPYOUT @CLR(7)	;Clear the screen
	POPJ P,

CLR:	DMCLRH
	DDCLRH

DDCLRH:	DDCLR
	2
	0
	0

DDCLR:	CW 1,17,2,0,1,46
	0					;Halt

DMCLRH:	XWD DMFLAG,DMCLR
	1
	0
	0

DMCLR:	77474		;clear

ECHO:	MOVEI 1,4	;Assume we want echoing on (DON = 4)
	SKIPN 2		;See what we're to do
	SOJ 1,		;If ac2 = 0 (false) turn echoing off (DOFF = 3)
	SETZM 0		;Use our terminal
	PTJOBX 0	;Do it
	POPJ P,

JOBINT ← 71

ESCINI:	MOVEM 2,ESCFLG	;Get address of flag word;
	HRRZI 1,ESCVEC	;Use ESCVEC instead of JOBCNI, JOBTPC & JOBAPR
	MOVEM 1,JOBINT	;So Pascal can use old style interrupts
	HRLZI 1,4	;Escape-I interrupt bit
	INTENB 1,	;Enable interrupts for it
	POPJ P,

ESCINT:	SETOM @ESCFLG	;Set flag when we get an escape-I interrupt
	DISMIS		;That's all we need to do

	RELOC		;Use low seg

ESCVEC:	0		;JOBCNI
	0		;JOBTPC
	ESCINT		;JOBAPR

ESCFLG:	0

	RELOC		;back to high seg

;Cursor postioning routine: SHOWCU

SHOWCU:	CAIG 3,=80	;check for line overflow
	JRST .+3	; no
	SUBI 3,=80	; yes - correct column number
	AOJ 2,		;  & bump line number
	SOJ 3,		;columns go from 0 not 1
	ADDI 2,2	;line 0 is really at line 2, so wholine isn't clobbered
	SKIPE TERM	;What sort of terminal are we using
	JRST SHDDCU	; Handle DD's below
SHDMCU:	HRRM 2,CURADR	;line	DM
	HRLM 3,CURADR	;column
	CURSOR CURADR
	POPJ P,

	RELOC		;low seg
CURADR:	0
	RELOC		;back to high seg

				;Most of this is stolen from E/363P
SHDDCU:	MOVE 5,[CW 3,0,4,0,5,0]	;Column number and line address (high & low parts)
	IMULI 2,=12		;Convert to scan line number
	ADDI 2,=10		;Put our cursor near bottom of text line
	DPB 2,[POINT 4,5,23]	;Put in low order line address
	LSH 2,-4
	DPB 2,[POINT 5,5,15]	;And high order line address
	MOVE 2,3		;Column number
	IMULI 2,6		;Column times char width in bits gives bit position
	LDB 3,[POINT 3,2,35]	;Get bit offset within graphic column
	LSH 2,-3		;Get graphic column number in low-order bits
	ADDI 2,1		;First graphics column under normal text is 1
	DPB 2,[POINT 6,5,7]	;Insert column in cmd word
	MOVEM 5,NEWCUR		;Store away new cursor position
	MOVN 3,3
	MOVSI 1,770000		;Bits for cursor
	LSH 1,-1(3)		;Adjust bits into right position within column
	TRZ 1,17		;Make sure no stray bits on
	IORI 1,2		;Make this a graphics word
	MOVEM 1,CURBTS
	DPYOUT CURHD		;Do it
	MOVEM 5,OLDCUR		;So we can erase it next time
	POPJ P,

CURHD:	CURCMD
	10
	0
	0

	RELOC		;low seg
CURCMD: CW 1,7,1,7,1,7		;Graphics mode to diddle cursors
OLDCUR:	CW 3,1,4,0,5,10		;Position cmd for old cursor
	2			;Graphic bits to erase old cursor
	CW 0,0,3,1,3,1		;Now an execute to erase the bits
NEWCUR:	CW 3,1,4,0,5,10		;Position cmd for new cursor
CURBTS:	2			;Graphic bits to draw new cursor
	CW 0,0,3,1,3,1		;Now an execute to write the bits
	0			;and finally a halt
	RELOC		;back to high seg

;Aux routines to set up position commands: DMPOS & DDPOS

DMPOS:	HRRZI 1,37614		; '177 & '14 = set cursor position
	LSH 1,7
	CAIG 3,=80		;check for line overflow
	JRST .+3		; no
	SUBI 3,=80		; yes - correct column number
	AOJ 2,			;  & bump line number
	SOJ 3,			;DM columns go from 0 not 1
	IOR 1,3			;Grab column value
	XORI 1,140
	LSH 1,7
	ADDI 2,2		;line 0 -> line 2, so wholine isn't clobbered
	IOR 1,2			;Grab line number
	XORI 1,140
	LSH 1,1
	POPJ P,

DDPOS:	CAIG 3,=80		;check for line overflow
	JRST .+3		; no
	SUBI 3,=80		; yes - correct column number
	AOJ 2,			;  & bump line number
	ADDI 2,2		;line 0 -> line 2, so wholine isn't clobbered
	IMULI 2,14		;Compute DD line number from screen text line number
	DPB 2,[400400,,2]	; (this code is snarfed from e/171p)
	TRZ 2,17
	ROT 2,20
	TDO 2,[CW 3,0,4,0,5,0]
	AOJ 3,			;DD columns start at 2
	LSH 3,=28		;Shift it to proper byte
	IOR 2,3			;Or it into command word
	MOVEM 2,LPOS		;Set up line address command
	POPJ P,

;Line output routine: OUTLIN

OUTLIN:	CAIG 5,0		;Make sure # chars to print > 0
	POPJ P,			; else nothing to do
	MOVE 6,5		;Compute col + length ( + 1)
	ADD 6,3
	CAILE 6,=81		;Make sure line won't be too long
	PUSHJ P,OUTLNG		; handle long lines below
	SKIPE TERM		;What sort of terminal are we using
	JRST ODDLIN		; Handle DD's below
ODMLIN:	PUSHJ P,DMPOS		;Set up DM cursor address
	MOVEM 1,LPOS		;Set up line address
	MOVE 6,4		;Get offset of first char to write
;	SOJ 6,			;Convert bytes to word offset
	IDIVI 6,5		; (ac7 = byte offset in first word)
	MOVE 10,TBASE		;Array base address
	ADD 10,6		;base + offset
	MOVSS 10		;Put it in left half of AC
	HRRI 10,LBUF		;DM buffer goes in right half
	MOVE 1,5		;Get # of chars to write
	ADD 1,7			;Plus any leading chars in first word
	IDIVI 1,5		;Convert to words (ac2 = # extra bytes)
	CAIE 2,0		;If any extra bytes
	AOJ 1,			; need to bump # of words to transfer	
	BLT 10,LBUF-1(1)	;Transfer line into buffer
	MOVE 10,BMASK(7)	;Get bit mask
	ANDM 10,LBUF		;Zero out extraneous leading chars
	MOVE 10,BMASK(2)	;Now handle trailing chars
	CAIE 2,0		; (if any)
	ANDCAM 10,LBUF-1(1)	;Zero out extraneous trailing chars
	HRLZI 10,774560		; 177 & 27 = erase til end of line
	MOVEM 10,LBUF(1)
	ADDI 1,2		;Number of words to send DM
	MOVEM 1,LBSIZ
	DPYOUT LBCMD		;Do it!
	POPJ P,

ODDLIN:	PUSHJ P,DDPOS		;Set up DD position command
	MOVE 6,4		;Get offset of first char to write
;	SOJ 6,			;Convert bytes to word offset
	IDIVI 6,5		; (ac7 = byte offset in first word)
	MOVE 10,TBASE		;Array base address
	ADD 10,6		;base + offset
	HRRZI 11,LBUF		;DD buffer goes in LBUF
	MOVE 1,5		;Get # of chars to write
	ADD 1,7			;Plus any leading chars in first word
	IDIVI 1,5		;Convert to words (ac2 = # extra bytes)
	CAIE 2,0		;If any extra bytes
	AOJ 1,			; need to bump # of words to transfer	
	MOVN 5,1
	HRL 10,5		;ac7 = -N,,TBASE+offset
LPLP:	MOVE 3,(10)		;Get next word to transfer
	TRO 3,1			;Make it a text word
	MOVEM 3,(11)		;Transfer it into the buffer
	AOJ 11,
	AOBJN 10,LPLP		;Get all of them
	MOVE 10,BMASK(7)	;Get bit mask
	TRO 10,1
	ANDM 10,LBUF		;Zero out extraneous leading chars
	MOVE 10,BMASK(2)	;Now handle trailing chars
	CAIE 2,0		; (if any)
	ANDCAM 10,LBUF-1(1)	;Zero out extraneous trailing chars
	MOVE 0,[CW 0,0,4,0,4,0]
	MOVEM 0,LBUF(1)		;Append an execute command
	SETZM LBUF+1(1)		;Append a halt command
	ADDI 1,4		;Number of words to send DD
	MOVEM 1,LBSIZ
	DPYOUT LBCMD		;Do it!
	POPJ P,

BMASK:	BYTE (7) 177,177,177,177,177	;Masks to zero leading chars
	BYTE (7) 0,177,177,177,177	;Use complement for killing trailing chars
	BYTE (7) 0,0,177,177,177
	BYTE (7) 0,0,0,177,177
	BYTE (7) 0,0,0,0,177

	RELOC		;use low seg
LBCMD:	XWD DDFLAG,LBCMD1
LBSIZ:	10		;# of words to write out
	0
	LPOS		;address of low order line command

LBCMD1:	CW 1,46,1,46,1,46
LPOS:	0		;Cursor command for start of line
LBUF:	BLOCK =20
	RELOC		;back to high seg

OUTLNG:	CAILE 3,=80	;Don't bother if col > 80
	POPJ P,		; just return
	PUSH P,2	;Save line number
	SUBI 6,=81	;# of chars for overflow line
	PUSH P,6	;Save it
	SUB 5,6		;# of chars for first line
	MOVE 6,4	;Offset of 1st char for 1st line
	ADD 6,5		;Offset of 1st char for 2nd line
	PUSH P,6	; save it
	PUSHJ P,OUTLIN	;Write out 1st line
	POP P,4		;Offset of 1st char
	POP P,5		;# of chars
	POP P,2		;Line number
	AOJ 2,		; bump it
	MOVEI 3,1	;Start 2nd line in 1st column
	POPJ P,		;Finally return for last part of line

;Character routines: GETCHAR, ANYCHAR & OUTCHAR

GETCHA:	INCHRW 1		;Read in the next character
	TRZ 1,400		;We never want to see meta!
	MOVEM 1,1(P)		;Return char
	POPJ P,

ANYCHA:	SETOM 1			;Assume there's a character to read in
	INCHRS (2)		;Read in the next character (if any)
	SETZM 1			;FALSE if nothing to read yet
	MOVEM 1,1(P)		;Report success or failure
	POPJ P,

OUTCHA:	LSH 4,=29		;Left justify char to output
	SKIPE TERM		;What sort of terminal are we using
	JRST OUTCDD		; Handle DD's below
OUTCDM:	PUSHJ P,DMPOS		;Set up DM position command
	MOVEM 1,LPOS		;Set up line address
	JUMPE 5,ODM1		;Skip ahead if not bold
	HRRI 4,37616		; 177 & 16 = bold on
	ROT 4,-=14		;Put bold cmd in high bits
ODM1:	MOVEM 4,LBUF		;Stick char to write in buffer
	MOVEI 1,2		;Number of words to send DM
	MOVEM 1,LBSIZ
	DPYOUT LBCMD		;Do it!
	POPJ P,

OUTCDD:	PUSHJ P,DDPOS		;Set up DD position command
	TRO 4,1			;Make it a text word
	MOVEM 4,LBUF		;Transfer it into the buffer
	MOVE 1,[CW 0,0,4,0,4,0]
	MOVEM 1,LBUF+1		;Append an execute command
	SETZM LBUF+2		;Append a halt command
	MOVEI 1,5		;Number of words to send DD
	MOVEM 1,LBSIZ
	DPYOUT LBCMD		;Do it!
	POPJ P,

;Special DM routines: INSCHA, DELCHA, INSLIN & DELLIN

INSCHA:	PUSHJ P,DMPOS		;Set up DM position command
	LSH 1,7			;Flush 177 byte
	MOVEM 1,IDPOS		;Set up line address
	MOVE 1,[BYTE (7) 20,34,30,16,0]	;Enter i/d mode, add space, can, bold
	MOVEM 1,IDPOS+1		;Set up I/D command
	LSH 4,=29		;Left shift char to output
	MOVEM 4,IDPOS+2		;Stick it into buffer
	MOVEI 1,3
	MOVEM 1,IDCMD+1		;Three words to write out
	DPYOUT IDCMD		;Do it!
	POPJ P,

DELCHA:	PUSHJ P,DMPOS		;Set up DM position command
	LSH 1,7			;Flush 177 byte
	MOVEM 1,IDPOS		;Set up line address
	MOVE 1,[BYTE (7) 20,10,30,16,0]	;Enter i/d mode, delete char, can, bold
	MOVEM 1,IDPOS+1		;Set up I/D command
	MOVEI 1,2
	MOVEM 1,IDCMD+1		;Two words to write out
	DPYOUT IDCMD		;Do it!
	POPJ P,

INSLIN:	MOVEI 4,12		;12 = Add row in i/d mode
	CAIA			;Skip ahead to common code
DELLIN:	MOVEI 4,32		;32 = Delete row in i/d mode
	SKIPN 5,3		;Save # of lines to insert/delete
	POPJ P,			; (if none all done)
	MOVEI 3,1
	PUSHJ P,DMPOS		;Set up positioning command;
	LSH 1,7			;Flush 177 byte
	IORI 1,40		;Or enter i/d mode (= 20) into command
	MOVEM 1,IDPOS		;Set up line address & enter i/d mode
	MOVE 1,[POINT 7,IDPOS+1] ;Byte pointer for where to put i/d chars
IDLP:	IDPB 4,1		;Move it into buffer
	SOJG 5,IDLP		;# of lines to do
	MOVEI 4,30		;Exit i/d mode
	IDPB 4,1
	IDPB 5,1		;Tack on some nulls to fill word
	IDPB 5,1
	IDPB 5,1
	IDPB 5,1
	IBP 1
	HRRZ 2,1		;Ac2 = end of command buffer
	SUBI 2,IDPOS		;Get # of chars to write out
	MOVEM 2,IDCMD+1
	DPYOUT IDCMD		;Do it!
	POPJ P,

	RELOC		;use low seg
IDCMD:	XWD DMQUOT+DDFLAG+USERGO,IDPOS
	3		;# of words to write out
	0
	0

IDPOS:	0		;Cursor command for start of line
	BYTE (7) 20,34,30,16,0	;Enter i/d mode, add space, can, bold
	0		;Char to output
	0
	0
	0
	RELOC		;back to high seg

;Line editor routines: LINEDP & LOADED

LINEDP:	ADDI 2,2	;line 0 is really at line 2, so wholine isn't clobbered
	AOJ 2,			;we use the same algorithm as E (/171p)
	LSH 2,7			;multiply by 200
	MOVE 3,[-3]		;For DM's
	SKIPE TERM		;Different spacing for different terminal types
	MOVE 3,[-5]		;For DD's
	IDIV 2,3
	ADDI 2,1000		;top of screen = 1000
	LEYPOS (2)		;Do it
	POPJ P,

LOADED:	MOVEI 1,0		;Load line editor & move cursor to char #N
	SOJLE 5,LOED0		; (actually <cntl><n-1><cntl><space>)
	IDIVI 5,=10
	MOVE 1,[BYTE (9) 260,260,240,0]	;<cntl>0 <cntl>0 <cntl><sp> null
	LSH 5,=27
	ADD 1,5			;Deal with 10's
	LSH 6,=18
	ADD 1,6			;Deal with 1's
LOED0:	MOVEM 1,LOED3		;Number of spaces into line to move cursor
	MOVE 10,[POINT 7,LBUF]	;Byte pointer for where to put line
	JUMPE 4,LOED1		;Skip ahead if no chars to load
	MOVE 6,3		;Get offset of first char to load in
;	SOJ 6,			;Convert bytes to word offset
	IDIVI 6,5		; (ac7 = byte offset in first word)
	ADD 6,TBASE		;base + offset
	IMUL 7,[-7]
	ADDI 7,=36		;Make up P field
	LSH 7,=30
	XOR 7,[POINT 7,(6),35]	;Need to make up byte pointer
LOEDLP:	ILDB 1,7		;Get next char
	IDPB 1,10		;Move it into buffer
	SOJG 4,LOEDLP		;Get them all
LOED1:	HRRZI 1,15		;Tack on a CR
	IDPB 1,10		;Move it into buffer
	PUSHJ P,LINEDP		;Move line editor to right line
	PTL7W9 LOED2		; & load it
	POPJ P,

LOED2:	0			;Use own terminal
	LBUF			;address of string to load
	LOED3			;9 bit string of simulated type ahead

	RELOC			;Back to low seg
LOED3:	BYTE (9) 260,260,240,0	;<cntl>0 <cntl>0 <cntl><sp>
	RELOC			;To high seg

END